home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / overwrt.exe / OVRTPU.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-12  |  2KB  |  93 lines
  1. Unit OvrTpu;
  2.  
  3. INTERFACE
  4.  
  5. uses
  6.   WObjects, WinTypes, WinProcs;
  7.  
  8. const
  9.   wm_ChangeCaret = wm_User + 1000;
  10.  
  11. type
  12.   POverwrite = ^TOverwrite;
  13.   TOverwrite = object(TEdit)
  14.     Overwrite : boolean;
  15.     constructor InitResource(AParent : PWindowsObject;
  16.                              ResourceID, ATextLen : word);
  17.     procedure WMGetDlgCode(var Msg : TMessage);
  18.       virtual wm_First + wm_GetDlgCode;
  19.     procedure ENSetFocus(var Msg : TMessage);
  20.       virtual nf_first + en_SetFocus;
  21.     procedure WMChangeCaret(var Msg : TMessage);
  22.       virtual wm_First + wm_ChangeCaret;
  23.     procedure WMKeyDown(var Msg : TMessage);
  24.       virtual wm_First + wm_KeyDown;
  25.     procedure Edit(var Msg : TMessage);
  26.      virtual wm_first + wm_Char;
  27.   end;
  28.  
  29. IMPLEMENTATION
  30.  
  31. constructor TOverwrite.InitResource(AParent : PWindowsObject;
  32.                                  ResourceID, ATextLen : Word);
  33. begin
  34.   TEdit.InitResource(AParent, ResourceID, ATextLen);
  35.   Overwrite:=false;
  36. end;
  37.  
  38. procedure TOverwrite.WMGetDlgCode(var Msg : TMessage);
  39. begin
  40.   Msg.Result:=Dlgc_WantAllKeys;
  41. end;
  42.  
  43. procedure TOverwrite.ENSetFocus(var Msg : TMessage);
  44. begin
  45.   HideCaret(LoWord(Msg.lParam));
  46.   SendMessage(HWindow,wm_ChangeCaret,0,0);
  47. end;
  48.  
  49. procedure TOverwrite.WMChangeCaret(var Msg : TMessage);
  50. var
  51.   Dc : HDc;
  52.   Tm : TTextMetric;
  53.   CyHeight,
  54.   CxWidth : integer;
  55. begin
  56.   DC:=GetDC(HWindow);
  57.   GetTextMetrics(DC,Tm);
  58.   cyHeight:=Tm.TmHeight;
  59.   cxWidth:=Tm.TmAveCharWidth;
  60.   ReleaseDC(HWindow,DC);
  61.   DestroyCaret;
  62.   if (NOT Overwrite) then
  63.     CreateCaret(HWindow,0,2,cyHeight)
  64.   else
  65.     CreateCaret(HWindow,0,cxWidth,cyHeight);
  66.   ShowCaret(HWindow);
  67. end;
  68.  
  69. procedure TOverwrite.WMKeyDown(var Msg : TMessage);
  70. begin
  71.   if (Msg.wParam = VK_INSERT) then
  72.     begin
  73.       Overwrite:=(NOT Overwrite);
  74.       SendMessage(HWindow,wm_ChangeCaret,0,0);
  75.     end
  76.   else
  77.     DefWndProc(Msg);
  78. end;
  79.  
  80. procedure TOverwrite.Edit(var Msg : TMessage);
  81. var
  82.   lPos : longint;
  83. begin                  
  84.   if (Overwrite) AND (NOT (Msg.wParam IN [VK_DELETE,VK_BACK,VK_ESCAPE])) then
  85.     begin
  86.       lPos:=SendMessage(HWindow,Em_GetSel,0,0);
  87.       SendMessage(HWindow,Em_SetSel,0,MakeLong(LoWord(lPos),LoWord(lPos)+1));
  88.       SendMessage(HWindow,Em_ReplaceSel,0,Longint(nil));
  89.     end;
  90.   DefWndProc(Msg);
  91. end;
  92.  
  93. end.